Attribute VB_Name = "modIPAOHook"
'***************************************************************
' (c) Copyright 2000 Matthew J. Curland
'
' This file is from the CD-ROM accompanying the book:
' Advanced Visual Basic 6: Power Techniques for Everyday Programs
'   Author: Matthew Curland
'   Published by: Addison-Wesley, July 2000
'   ISBN: 0-201-70712-8
'   http://www.PowerVB.com
'
' You are entitled to license free distribution of any application
'   that uses this file if you own a copy of the book, or if you
'   have obtained the file from a source approved by the author. You
'   may redistribute this file only with express written permission
'   of the author.
'
' This file depends on:
'   References:
'     VBoostTypes6.olb (VBoost Object Types (6.0))
'     OleTypes.olb (VBoost: Ole Type Definitions)
'     VBoost6.Dll (VBoost Object Implementation (6.0)) (optional)
'   Files:
'     VBoost.Bas
'   Minimal VBoost conditionals:
'     VBOOST_INTERNAL = 1 : VBOOST_CUSTOM = 1 : VBOOST_BLIND = 1 : VBOOST_BLIND_32 = 1
'   Conditional Compilation Values:
'     None
'
' This file is discussed in Chapter 16.
'***************************************************************
Option Explicit
Public Type IPAOHook 'IOleInPlaceActiveObjectHook
    'Explicitly duplicate the BlindDelegator structure so that we can
    'set the type of the pInner entry and assign directly to the pInner
    'and pOuter entries without using CreateDelegator.
    'BD As BlindDelegator
    pVTable As Long
    pInner As IOleInPlaceActiveObject
    pOuter As IUnknown
    cRefs As Long
    pfnDestroy As Long           'Set to DestroyIPAOHook to clean up AccelHook reference
    'End of expanded BlindDelegator structure
    AccelHook As IHookAccelerator 'Strong reference to pHookAccelerator value, cleared in pfnDestroy
    pControllingUnknown As Long  'Weak reference to controlling IUnknown pointer
    pIPAONative As Long          'Weak reference to native InPlaceActiveObject
    pHookAccelerator As Long     'Weak reference to accelerator hook
End Type
Private Type IPAOVTable
    VTable(9) As Long
End Type
Private IID_IOleInPlaceActiveObject As VBGUID
Private m_IPAOVTable As IPAOVTable
Private m_pIPAOVTable As Long
Public Sub InitializeIPAOHook(Hook As IPAOHook, ByVal pUnk As IUnknown)
Dim pHook As IHookAccelerator
Dim pIPAO As IOleInPlaceActiveObject
    If VBoost Is Nothing Then InitVBoost
    Set pHook = pUnk
    Set pIPAO = pUnk
    With VBoost
        .Assign Hook.pControllingUnknown, pUnk
        .Assign Hook.pHookAccelerator, pHook
        .Assign Hook.pIPAONative, pIPAO
        If m_pIPAOVTable = 0 Then
            CopyMemory m_IPAOVTable.VTable(0), ByVal VBoost.BlindFunctionPointer(-1), 40
            m_IPAOVTable.VTable(5) = FuncAddr(AddressOf TranslateAccelerator)
            m_pIPAOVTable = VarPtr(m_IPAOVTable)
        End If
        Hook.pVTable = m_pIPAOVTable
        Hook.pfnDestroy = FuncAddr(AddressOf DestroyIPAOHook)
    End With
End Sub
Public Sub OverrideActiveObject(Hook As IPAOHook, ByVal pObject As IOleObject)
Dim pInPlaceSite As IOleInPlaceSite
Dim pInPlaceFrame As IOleInPlaceFrame
Dim pInPlaceUIWindow As IOleInPlaceUIWindow
Dim pInPlaceActiveObject As IOleInPlaceActiveObject
Dim PosRect As RECT
Dim ClipRect As RECT
Dim FrameInfo As OLEINPLACEFRAMEINFO
    'Get the in place site from the client site
    Set pInPlaceSite = pObject.GetClientSite
    
    'Get the context. We only need the first two, but
    'IE crashes if you pass NULL to the final parameters.
    pInPlaceSite.GetWindowContext pInPlaceFrame, pInPlaceUIWindow, PosRect, ClipRect, FrameInfo
    
    With Hook
        'Initialize if the blind delegator isn't already in use. Note that
        'the references in the BlindDelegator structure will be cleared
        'before the controlling IUnknown which owns it, so there is no
        'need for explicit cleanup code.
        If .cRefs = 0 Then
            VBoost.AssignAddRef .pInner, .pIPAONative
            VBoost.AssignAddRef .pOuter, .pControllingUnknown
            VBoost.AssignAddRef .AccelHook, .pHookAccelerator
        End If
        VBoost.AssignAddRef pInPlaceActiveObject, VarPtr(.pVTable)
    End With
    If pInPlaceUIWindow Is Nothing Then
        pInPlaceFrame.SetActiveObject pInPlaceActiveObject, vbNullString
    Else
        pInPlaceUIWindow.SetActiveObject pInPlaceActiveObject, vbNullString
    End If
End Sub
Private Function DestroyIPAOHook(This As IPAOHook, pInner As IUnknown, pOuter As IUnknown) As Long
    'Clear AccelHook so that the controlling IUnknown
    'doesn't own a reference to itself.
    Set This.AccelHook = Nothing
End Function
Private Function TranslateAccelerator(This As IPAOHook, lpmsg As OleTypes.MSG) As Long
Dim hr As Long
    On Error Resume Next
    hr = 1
    This.AccelHook.TranslateAccelerator lpmsg, hr
    If Err Then hr = 1
    On Error GoTo 0
    If hr Then
        'Not handled here, pass on to real TranslateAccelerator
        hr = This.pInner.TranslateAccelerator(lpmsg)
    End If
    TranslateAccelerator = hr
End Function
Private Function FuncAddr(ByVal pfn As Long) As Long
    FuncAddr = pfn
End Function

